home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / baswind2.arc / MAKEWIND.SUB < prev    next >
Encoding:
Text File  |  1986-11-11  |  2.8 KB  |  71 lines
  1.        '************************** WINDOW SUBROUTINE *************************
  2.        SUB MAKEWIND(ULR%,ULC%,LRR%,LRC%,FRAME%,FORE%,BACK%,GROW%,SHADOW%,LABEL$) STATIC
  3.        DEFINT A-Z
  4.        IF GROW=0 THEN GOSUB STD : GOTO DONE
  5.        '-------------------- Growing Window Module ---------------------------
  6.        SHADOW=0
  7.        X1=ULC+INT((LRC-ULC)/2)
  8.        X2=LRC-INT((LRC-ULC)/2)
  9.        Y1=ULR+INT((LRR-ULR)/2)
  10.        Y2=LRR-INT((LRR-ULR)/2)
  11.   NXT: IF X1>ULC THEN X1=X1-3 : IF X1<ULC THEN X1=ULC
  12.        IF X2<LRC THEN X2=X2+3 : IF X2>LRC THEN X2=LRC
  13.        IF Y1>ULR THEN Y1=Y1-1
  14.        IF Y2<LRR THEN Y2=Y2+1
  15.        GOSUB SETUP
  16.        IF (X1=ULC) AND (X2=LRC) AND (Y1=ULR) AND Y2=(LRR) THEN GOTO DONE ELSE GOTO NXT
  17.  DONE: GROW=0
  18.        EXIT SUB
  19.        '------------------- Regular Window Module ----------------------------
  20.   STD: X1=ULC : X2=LRC : Y1=ULR : Y2=LRR
  21. SETUP: ATTR=(BACK AND 7)*16+FORE
  22.        IF FRAME=0 THEN GOSUB NOFRAME ELSE ON FRAME GOSUB H1V1,H2V2,H1V2,H2V1
  23.        IF LABEL$="" OR LEN(LABEL$)>(LEN(TOP$)-5) THEN GOTO SHADE
  24.        MID$(TOP$,2)="["+LABEL$+"]"
  25. SHADE: '---------------------------- Shadow Module ---------------------------
  26.        IF SHADOW=0 THEN GOTO MAKE
  27.        COL=X1-3 : DAT$=STRING$((X2-X1)+3,32) : BLACK=0
  28.        FOR I=Y1 TO (Y2+2)
  29.          ROW=I : CALL FASTPRT(DAT$,ROW,COL,BLACK)
  30.        NEXT I
  31.        SHADOW=0
  32.  MAKE: '------------------------ Produce Window Module -----------------------
  33.        ROW=Y1-1 : COL=X1-1
  34.        CALL FASTPRT(TOP$,ROW,COL,ATTR)
  35.        FOR I=Y1 TO Y2
  36.          ROW=I : COL=X1-1
  37.          CALL FASTPRT(MIDL$,ROW,COL,ATTR)
  38.        NEXT I
  39.        ROW=Y2+1 : COL=X1-1
  40.        CALL FASTPRT(BOTTM$,ROW,COL,ATTR)
  41.        RETURN
  42.  H1V1: '--------------- Single Line Frame ---------------------
  43.        TOP$  =CHR$(218)+STRING$((X2-X1)+1,196)+CHR$(191)
  44.        MIDL$ =CHR$(179)+STRING$((X2-X1)+1, 32)+CHR$(179)
  45.        BOTTM$=CHR$(192)+STRING$((X2-X1)+1,196)+CHR$(217)
  46.        RETURN
  47.  H2V2: '--------------- Double Line Frame ----------------------
  48.        TOP$  =CHR$(201)+STRING$((X2-X1)+1,205)+CHR$(187)
  49.        MIDL$ =CHR$(186)+STRING$((X2-X1)+1, 32)+CHR$(186)
  50.        BOTTM$=CHR$(200)+STRING$((X2-X1)+1,205)+CHR$(188)
  51.        RETURN
  52.  H1V2: '---- Double Vertical, Single Horizontal Line Frame ----
  53.        TOP$  =CHR$(214)+STRING$((X2-X1)+1,196)+CHR$(183)
  54.        MIDL$ =CHR$(186)+STRING$((X2-X1)+1, 32)+CHR$(186)
  55.        BOTTM$=CHR$(211)+STRING$((X2-X1)+1,196)+CHR$(189)
  56.        RETURN
  57.  H2V1: '---- Double Horizontal, Single Vertical Line Frame ----
  58.        TOP$  =CHR$(213)+STRING$((X2-X1)+1,205)+CHR$(184)
  59.        MIDL$ =CHR$(179)+STRING$((X2-X1)+1, 32)+CHR$(179)
  60.        BOTTM$=CHR$(212)+STRING$((X2-X1)+1,205)+CHR$(190)
  61.        RETURN
  62.  
  63. NOFRAME:'---------------- No Frame ----------------------------
  64.  
  65.        TOP$=SPACE$((X2-X1)+3)
  66.        MIDL$=TOP$
  67.        BOTTM$=TOP$
  68.        RETURN
  69.  
  70.        END SUB
  71.